home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0119_EGA-VGA Font Editor.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  45KB  |  1,426 lines
  1.  
  2. {..$define First} { disable to force loading of file }
  3.  
  4. {use this if you launch the program for the first time (you also may add a
  5. code to detect if the file already exiists but... normally, you should use
  6. this option once.}
  7.  
  8. program GenSmallCar;
  9. {CopyRight Thierry De Leeuw 1994}
  10. uses crt, dos, graph;
  11.  
  12. Type TSmallCar = Array [0..8] of Byte;
  13.      PSmallCar = ^TSmallCar;
  14.  
  15. var  SmallCar : Array[32..180] of PSmallCar;
  16.      Buffer   : Array[0..7,0..8] of Char;
  17.      grDriver : Integer;
  18.      grMode   : Integer;
  19.      ErrCode  : Integer;
  20.      EnCours  : Byte;
  21.  
  22. Procedure ReserveMemoire;
  23. var i : byte;
  24. begin
  25.    For i := 32 to 180 do
  26.    begin
  27.       New(SmallCar[i]);
  28.    end;
  29. end;
  30.  
  31. procedure ChargeTable;
  32. var Fichier : Text;
  33.     i       : byte;
  34.     j       : byte;
  35. begin
  36.    {$Ifndef First}
  37.    Assign(Fichier, 'Small.FON');
  38.    Reset(Fichier);
  39.    {$Endif}
  40.    For i := 32 to 180 do
  41.    begin
  42.       for j := 0 to 8 do
  43.       begin
  44.          {$IFDEF First}
  45.          SmallCar[i]^[j] := 0;
  46.          {$Else}
  47.          readLn(Fichier, SmallCar[i]^[j]);
  48.          {$Endif}
  49.       end;
  50.       {$Ifndef First}
  51.       Readln(Fichier);
  52.       {$Endif}
  53.    end;
  54.    {$Ifndef First}
  55.    Close(Fichier);
  56.    {$endif}
  57. end;
  58.  
  59. function Analyse(Valeur: byte) : String;
  60. var Tmp : String[19];
  61. begin
  62.    Tmp := ' ';
  63.    Analyse := Tmp
  64.  
  65.  
  66. end;
  67.  
  68. Procedure Update(No : Byte);
  69. var i : byte;
  70.     j : byte;
  71.  
  72. begin
  73.    ClrScr;
  74.    LowVideo;
  75.    GotoXY(22,1);
  76.    Write('Edition du caractère n° ',No:3,' - "',Chr(No),'".');
  77.    GotoXY(22,2);
  78.    Write('══════════════════════════════════');
  79.    gotoXY(30,4);
  80.    Write('╔═════════════════╗');
  81.    gotoXY(30,5);
  82.    Write('║                 ║');
  83.    gotoXY(30,6);
  84.    Write('║                 ║');
  85.    gotoXY(30,7);
  86.    Write('║                 ║');
  87.    gotoXY(30,8);
  88.    Write('║                 ║');
  89.    gotoXY(30,9);
  90.    Write('║                 ║');
  91.    gotoXY(30,10);
  92.    Write('║                 ║');
  93.    gotoXY(30,11);
  94.    Write('║                 ║');
  95.    gotoXY(30,12);
  96.    Write('║                 ║');
  97.    gotoXY(30,13);
  98.    Write('║                 ║');
  99.    gotoXY(30,14);
  100.    Write('╚═════════════════╝');
  101.    For i := 0 to 8 do
  102.    begin
  103.       gotoXY(31,5+i);
  104.       For j := 0 to 7 do
  105.          Write(' ' + Buffer[j,i]);
  106.    end;
  107. end;
  108.  
  109. Procedure Bufferize(No : Byte);
  110. var i : byte;
  111. begin
  112.    for i := 0 to 8 do
  113.    begin
  114.       if SmallCar[No]^[i] and 1 <> 0 then Buffer[0,i] := '*' else Buffer[0,i]
  115. := '·';
  116.       if SmallCar[No]^[i] and 2 <> 0 then Buffer[1,i] := '*' else Buffer[1,i]
  117. := '·';
  118.       if SmallCar[No]^[i] and 4 <> 0 then Buffer[2,i] := '*' else Buffer[2,i]
  119. := '·';
  120.       if SmallCar[No]^[i] and 8 <> 0 then Buffer[3,i] := '*' else Buffer[3,i]
  121. := '·';
  122.       if SmallCar[No]^[i] and 16 <> 0 then Buffer[4,i] := '*' else Buffer[4,i]
  123. := '·';
  124.       if SmallCar[No]^[i] and 32 <> 0 then Buffer[5,i] := '*' else Buffer[5,i]
  125. := '·';
  126.       if SmallCar[No]^[i] and 64 <> 0 then Buffer[6,i] := '*' else Buffer[6,i]
  127. := '·';
  128.       if SmallCar[No]^[i] and 128 <> 0 then Buffer[7,i] := '*' else
  129. Buffer[7,i] := '·';
  130.  
  131.    end;
  132. end;
  133.  
  134. procedure Encode(No : Byte);
  135. var i,j : byte;
  136. begin
  137.    for i := 0 to 8 do
  138.    begin
  139.       SmallCar[No]^[i] := 0;
  140.       if Buffer[0,i] = '*' then SmallCar[No]^[i] := 1;
  141.       if Buffer[1,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 2;
  142.       if Buffer[2,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 4;
  143.       if Buffer[3,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 8;
  144.       if Buffer[4,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 16;
  145.       if Buffer[5,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 32;
  146.       if Buffer[6,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 64;
  147.       if Buffer[7,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 128;
  148.    end;
  149. end;
  150.  
  151. procedure Preview;
  152. var i, j : byte;
  153. begin
  154.    initGraph(grDriver,GrMode,'\turbo\tp\');
  155.    for i := 0 to 8 do
  156.    begin
  157.       for j := 0 to 7 do
  158.       begin
  159.          if Buffer[j,i] = '*' then putpixel(j+GetMaxX div 2 ,i+GetMaxY div
  160. 2,15);
  161.       end;
  162.    end;
  163.    readkey;
  164.    closeGraph;
  165. end;
  166.  
  167. procedure PreviewAll;
  168. var i, j, k : byte;
  169. begin
  170.    initGraph(grDriver,GrMode,'\turbo\tp\');
  171.    for k := 32 to 96 do
  172.    begin
  173.       Bufferize(k);
  174.       for i := 0 to 8 do
  175.       begin
  176.          for j := 0 to 7 do
  177.          begin
  178.             if Buffer[j,i] = '*' then putpixel(j+(k-32) * 9 ,i+GetMaxY div
  179. 2-10,15);
  180.          end;
  181.       end;
  182.    end;
  183.    for k := 97 to 180 do
  184.    begin
  185.       Bufferize(k);
  186.       for i := 0 to 8 do
  187.       begin
  188.          for j := 0 to 7 do
  189.          begin
  190.             if Buffer[j,i] = '*' then putpixel(j+(k-97) * 9 ,i+GetMaxY div
  191. 2+10,15);
  192.          end;
  193.       end;
  194.    end;
  195.    readkey;
  196.    closeGraph;
  197. end;
  198.  
  199. function Edit(No : byte) : Char;
  200. var x, y : byte;
  201.     car  : Char;
  202.     Sortie : Boolean;
  203.     Go     : byte;
  204. begin
  205.    UpDate(No);
  206.    x := 0;
  207.    y := 0;
  208.    Sortie := false;
  209.  
  210.    repeat
  211.       GotoXY(32 + 2*x,5+y);
  212.       HighVideo;
  213.       Write(Buffer[x,y]);
  214.       GotoXY(32 + 2*x,5+y);
  215.       repeat
  216.       until keypressed;
  217.       car := ReadKey;
  218.       GotoXY(32 + 2*x,5+y);
  219.       LowVideo;
  220.       Write(Buffer[x,y]);
  221.       if (car = 'q') or (car = 'Q') then car := #13;
  222.       if car = #0 then car := ReadKey;
  223.       case car of
  224.          '2',chr(80)   : if y = 8 then y := 0 else inc(y);
  225.          '8',chr(72)   : if y = 0 then y := 8 else dec(y);
  226.          '4',chr(75)   : if x = 0 then x := 7 else dec(x);
  227.          '6',chr(77)   : if x = 7 then x := 0 else inc(x);
  228.          ' '           : if Buffer[x,y] = '*' then Buffer[x,y] := '·' else
  229. Buffer[x,y] := '*';
  230.          #13, #81, #73 : Sortie := true;
  231.          #27           : Sortie := True;
  232.          'G','g'       : begin
  233.                             GotoXY(20,24);
  234.                             Write('Aller à quel code ascii ? ');
  235.                             Read(Go);
  236.                             if (Go >= 32) and (go <= 180) then
  237.                             begin
  238.                                Encode(No);
  239.                                EnCours := Go -1;
  240.                                Car := #81;
  241.                                Sortie := true;
  242.                             end;
  243.                             GotoXY(1,24);
  244.                             ClrEol;
  245.                          end;
  246.  
  247.          'v'           : begin
  248.                            Preview;
  249.                            update(No);
  250.                          end;
  251.          'a'           : begin
  252.                             Encode(No);
  253.                             PreviewAll;
  254.                             Bufferize(No);
  255.                             Update(No);
  256.                          end;
  257.       end;
  258.    until (sortie);
  259.    Encode(No);
  260.    Edit := Car;
  261. end;
  262.  
  263. procedure EditeTable;
  264. var fin     : boolean;
  265.     Car     : char;
  266.     Car_Retour : char;
  267. begin
  268.    fin := false;
  269.    Encours := 32;
  270.    repeat
  271.       Bufferize(Encours);
  272.       Car_Retour := Edit(EnCours);
  273.       case car_Retour of
  274.          #13 : begin
  275.                   gotoXY(20,24);
  276.                   Write('Quitter ? ');
  277.                   Car := UpCase(readKey);
  278.                   GotoXY(1,24);
  279.                   ClrEol;
  280.                   if Car = 'O' then Fin := true;
  281.                end;
  282.          #81 : begin
  283.                   if EnCours = 180 then Encours := 32 else inc(EnCours);
  284.                end;
  285.          #73 : begin
  286.                   if EnCours = 32 then Encours := 180 else dec(EnCours);
  287.                end;
  288.          #27 : begin
  289.                   gotoXY(20,24);
  290.                   Write('Abandon des modifications ? ');
  291.                   Car := UpCase(readKey);
  292.                   GotoXY(1,24);
  293.                   ClrEol;
  294.                   if Car = 'O' then Halt(0);
  295.                end;
  296.       end;
  297.    until fin;
  298. end;
  299.  
  300. procedure SauveTable;
  301. var Fichier : Text;
  302.     i       : byte;
  303.     j       : byte;
  304. begin
  305.    Assign(Fichier, 'Small.FON');
  306.    Rewrite(Fichier);
  307.    For i := 32 to 180 do
  308.    begin
  309.       for j := 0 to 8 do
  310.       begin
  311.          writeLn(Fichier, SmallCar[i]^[j]);
  312.       end;
  313.       WriteLn(Fichier);
  314.    end;
  315.    Close(Fichier);
  316. end;
  317.  
  318. begin
  319.    DetectGraph(GrDriver, GrMode);
  320.    InitGraph(grDriver, grMode,'\turbo\tp\');
  321.    ErrCode := GraphResult;
  322.    if ErrCode <> grOk then
  323.    begin
  324.      Writeln('Graphics error:', GraphErrorMsg(ErrCode));
  325.      Halt(255);
  326.    end;
  327.    CloseGraph;
  328.  
  329.  
  330.    NormVideo;
  331.    ReserveMemoire;
  332.    ChargeTable;
  333.    EditeTable;
  334.    SauveTable;
  335. end.
  336.  
  337. {$define}
  338. {same remark as above}
  339.  
  340. program GenMidCar;
  341. {CopyRight Thierry De Leeuw 1994}
  342. uses crt, dos, graph;
  343.  
  344. Type TMidCar = Array [0..18] of Word;
  345.      PMidCar = ^TMidCar;
  346.  
  347. var  MidCar : Array[32..180] of PMidCar;
  348.      Buffer   : Array[0..15,0..18] of Char;
  349.      grDriver : Integer;
  350.      grMode   : Integer;
  351.      ErrCode  : Integer;
  352.      EnCours  : Byte;
  353.  
  354. Procedure ReserveMemoire;
  355. var i : byte;
  356. begin
  357.    For i := 32 to 180 do
  358.    begin
  359.       New(MidCar[i]);
  360.    end;
  361. end;
  362.  
  363. procedure ChargeTable;
  364. var Fichier : Text;
  365.     i       : byte;
  366.     j       : byte;
  367. begin
  368.    {$Ifndef First}
  369.    Assign(Fichier, 'Mid.FON');
  370.    Reset(Fichier);
  371.    {$Endif}
  372.    For i := 32 to 180 do
  373.    begin
  374.       for j := 0 to 18 do
  375.       begin
  376.          {$IFDEF First}
  377.          MidCar[i]^[j] := 0;
  378.          {$Else}
  379.          readLn(Fichier, MidCar[i]^[j]);
  380.          {$Endif}
  381.       end;
  382.       {$Ifndef First}
  383.       Readln(Fichier);
  384.       {$Endif}
  385.    end;
  386.    {$Ifndef First}
  387.    Close(Fichier);
  388.    {$endif}
  389. end;
  390.  
  391. function Analyse(Valeur: byte) : String;
  392. var Tmp : String[19];
  393. begin
  394.    Tmp := ' ';
  395.    Analyse := Tmp
  396.  
  397.  
  398. end;
  399.  
  400. Procedure Update(No : Byte);
  401. var i : byte;
  402.     j : byte;
  403.  
  404. begin
  405.    ClrScr;
  406.    LowVideo;
  407.    GotoXY(22,1);
  408.    Write('Edition du caractère n° ',No:3,' - "',Chr(No),'".');
  409.    GotoXY(22,2);
  410.    Write('══════════════════════════════════');
  411.    gotoXY(20,4);
  412.    Write('╔═════════════════════════════════╗');
  413.    gotoXY(20,5);
  414.    Write('║                                 ║');
  415.    gotoXY(20,6);
  416.    Write('║                                 ║');
  417.    gotoXY(20,7);
  418.    Write('║                                 ║');
  419.    gotoXY(20,8);
  420.    Write('║                                 ║');
  421.    gotoXY(20,9);
  422.    Write('║                                 ║');
  423.    gotoXY(20,10);
  424.    Write('║                                 ║');
  425.    gotoXY(20,11);
  426.    Write('║                                 ║');
  427.    gotoXY(20,12);
  428.    Write('║                                 ║');
  429.    gotoXY(20,13);
  430.    Write('║                                 ║');
  431.    gotoXY(20,14);
  432.    Write('║                                 ║');
  433.    gotoXY(20,15);
  434.    Write('║                                 ║');
  435.    gotoXY(20,16);
  436.    Write('║                                 ║');
  437.    gotoXY(20,17);
  438.    Write('║                                 ║');
  439.    gotoXY(20,18);
  440.    Write('║                                 ║');
  441.    gotoXY(20,19);
  442.    Write('║                                 ║');
  443.    gotoXY(20,20);
  444.    Write('║                                 ║');
  445.    gotoXY(20,21);
  446.    Write('║                                 ║');
  447.    gotoXY(20,22);
  448.    Write('║                                 ║');
  449.    gotoXY(20,23);
  450.    Write('║                                 ║');
  451.    gotoXY(20,24);
  452.    Write('╚═════════════════════════════════╝');
  453.    For i := 0 to 18 do
  454.    begin
  455.       gotoXY(21,5+i);
  456.       For j := 0 to 15 do
  457.          Write(' ' + Buffer[j,i]);
  458.    end;
  459. end;
  460.  
  461. Procedure Bufferize(No : Byte);
  462. var i : byte;
  463. begin
  464.    for i := 0 to 18 do
  465.    begin
  466.       if MidCar[No]^[i] and 1 <> 0 then Buffer[0,i] := '*' else Buffer[0,i] :=
  467. '·';
  468.       if MidCar[No]^[i] and 2 <> 0 then Buffer[1,i] := '*' else Buffer[1,i] :=
  469. '·';
  470.       if MidCar[No]^[i] and 4 <> 0 then Buffer[2,i] := '*' else Buffer[2,i] :=
  471. '·';
  472.       if MidCar[No]^[i] and 8 <> 0 then Buffer[3,i] := '*' else Buffer[3,i] :=
  473. '·';
  474.       if MidCar[No]^[i] and 16 <> 0 then Buffer[4,i] := '*' else Buffer[4,i]
  475. := '·';
  476.       if MidCar[No]^[i] and 32 <> 0 then Buffer[5,i] := '*' else Buffer[5,i]
  477. := '·';
  478.       if MidCar[No]^[i] and 64 <> 0 then Buffer[6,i] := '*' else Buffer[6,i]
  479. := '·';
  480.       if MidCar[No]^[i] and 128 <> 0 then Buffer[7,i] := '*' else Buffer[7,i]
  481. := '·';
  482.       if MidCar[No]^[i] and 256 <> 0 then Buffer[8,i] := '*' else Buffer[8,i]
  483. := '·';
  484.       if MidCar[No]^[i] and 512 <> 0 then Buffer[9,i] := '*' else Buffer[9,i]
  485. := '·';
  486.       if MidCar[No]^[i] and 1024 <> 0 then Buffer[10,i] := '*' else
  487. Buffer[10,i] := '·';
  488.       if MidCar[No]^[i] and 2048 <> 0 then Buffer[11,i] := '*' else
  489. Buffer[11,i] := '·';
  490.       if MidCar[No]^[i] and 4096 <> 0 then Buffer[12,i] := '*' else
  491. Buffer[12,i] := '·';
  492.       if MidCar[No]^[i] and 8192 <> 0 then Buffer[13,i] := '*' else
  493. Buffer[13,i] := '·';
  494.       if MidCar[No]^[i] and 16384 <> 0 then Buffer[14,i] := '*' else
  495. Buffer[14,i] := '·';
  496.       if MidCar[No]^[i] and 32768 <> 0 then Buffer[15,i] := '*' else
  497. Buffer[15,i] := '·';
  498.  
  499.    end;
  500. end;
  501.  
  502. procedure Encode(No : Byte);
  503. var i,j : byte;
  504. begin
  505.    for i := 0 to 18 do
  506.    begin
  507.       MidCar[No]^[i] := 0;
  508.       if Buffer[0,i] = '*' then MidCar[No]^[i] := 1;
  509.       if Buffer[1,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 2;
  510.       if Buffer[2,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 4;
  511.       if Buffer[3,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 8;
  512.       if Buffer[4,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 16;
  513.       if Buffer[5,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 32;
  514.       if Buffer[6,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 64;
  515.       if Buffer[7,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 128;
  516.       if Buffer[8,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 256;
  517.       if Buffer[9,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 512;
  518.       if Buffer[10,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 1024;
  519.       if Buffer[11,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 2048;
  520.       if Buffer[12,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 4096;
  521.       if Buffer[13,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 8192;
  522.       if Buffer[14,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 16384;
  523.       if Buffer[15,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 32768;
  524.    end;
  525. end;
  526.  
  527. procedure Preview;
  528. var i, j : byte;
  529. begin
  530.    initGraph(grDriver,GrMode,'\turbo\tp\');
  531.    for i := 0 to 18 do
  532.    begin
  533.       for j := 0 to 15 do
  534.       begin
  535.          if Buffer[j,i] = '*' then putpixel(j+GetMaxX div 2 ,i+GetMaxY div
  536. 2,15);
  537.       end;
  538.    end;
  539.    readkey;
  540.    closeGraph;
  541. end;
  542.  
  543. procedure PreviewAll;
  544. var i, j, k : byte;
  545. begin
  546.    initGraph(grDriver,GrMode,'\turbo\tp\');
  547.    for k := 32 to 64 do
  548.    begin
  549.       Bufferize(k);
  550.       for i := 0 to 18 do
  551.       begin
  552.          for j := 0 to 15 do
  553.          begin
  554.             if Buffer[j,i] = '*' then putpixel(j+(k-32) * 18 ,i+GetMaxY div
  555. 2-20,15);
  556.          end;
  557.       end;
  558.    end;
  559.    for k := 65 to 96 do
  560.    begin
  561.       Bufferize(k);
  562.       for i := 0 to 18 do
  563.       begin
  564.          for j := 0 to 15 do
  565.          begin
  566.             if Buffer[j,i] = '*' then putpixel(j+(k-65) * 18 ,i+GetMaxY div
  567. 2+10,15);
  568.          end;
  569.       end;
  570.    end;
  571.    for k :=  97 to 127 do
  572.    begin
  573.       Bufferize(k);
  574.       for i := 0 to 18 do
  575.       begin
  576.          for j := 0 to 15 do
  577.          begin
  578.             if Buffer[j,i] = '*' then putpixel(j+(k-97) * 18 ,i+GetMaxY div
  579. 2+30,15);
  580.          end;
  581.       end;
  582.    end;
  583.    for k :=  128 to 155 do
  584.    begin
  585.       Bufferize(k);
  586.       for i := 0 to 18 do
  587.       begin
  588.          for j := 0 to 15 do
  589.          begin
  590.             if Buffer[j,i] = '*' then putpixel(j+(k-128) * 18 ,i+GetMaxY div
  591. 2+50,15);
  592.          end;
  593.       end;
  594.    end;
  595.    for k :=  156 to 180 do
  596.    begin
  597.       Bufferize(k);
  598.       for i := 0 to 18 do
  599.       begin
  600.          for j := 0 to 15 do
  601.          begin
  602.             if Buffer[j,i] = '*' then putpixel(j+(k-156) * 18 ,i+GetMaxY div
  603. 2+70,15);
  604.          end;
  605.       end;
  606.    end;
  607.    readkey;
  608.    closeGraph;
  609. end;
  610.  
  611. function Edit(No : byte) : Char;
  612. var x, y : byte;
  613.     car  : Char;
  614.     Sortie : Boolean;
  615.     Go     : byte;
  616.     CaracTempo :  char;
  617. begin
  618.    UpDate(No);
  619.    x := 0;
  620.    y := 0;
  621.    Sortie := false;
  622.  
  623.    repeat
  624.       GotoXY(22 + 2*x,5+y);
  625.       HighVideo;
  626.       Write(Buffer[x,y]);
  627.       GotoXY(22 + 2*x,5+y);
  628.       repeat
  629.       until keypressed;
  630.       car := ReadKey;
  631.       GotoXY(22 + 2*x,5+y);
  632.       LowVideo;
  633.       Write(Buffer[x,y]);
  634.       if (car = 'q') or (car = 'Q') then car := #13;
  635.       if car = #0 then car := ReadKey;
  636.       case car of
  637.          '2',chr(80)   : if y = 18 then y := 0 else inc(y);
  638.          '8',chr(72)   : if y = 0 then y := 18 else dec(y);
  639.          '4',chr(75)   : if x = 0 then x := 15 else dec(x);
  640.          '6',chr(77)   : if x = 15 then x := 0 else inc(x);
  641.          ' '           : if Buffer[x,y] = '*' then Buffer[x,y] := '·' else
  642. Buffer[x,y] := '*';
  643.          #13, #81, #73 : Sortie := true;
  644.          #27           : Sortie := True;
  645.          'G','g'       : begin
  646.                             GotoXY(20,24);
  647.                             Write('Aller à quel code ascii ? ');
  648.                             Read(Go);
  649.                             if (Go >= 32) and (go <= 180) then
  650.                             begin
  651.                                Encode(No);
  652.                                EnCours := Go -1;
  653.                                Car := #81;
  654.                                Sortie := true;
  655.                             end;
  656.                             GotoXY(1,24);
  657.                             ClrEol;
  658.                          end;
  659.  
  660.          'v', 'V'      : begin
  661.                            Preview;
  662.                            update(No);
  663.                          end;
  664.          'a', 'A'      : begin
  665.                             Encode(No);
  666.                             PreviewAll;
  667.                             Bufferize(No);
  668.                             Update(No);
  669.                          end;
  670.          'c', 'C'      : begin
  671.                             gotoXY(20,24);
  672.                             Write('Copier quel caractère ? ');
  673.                             CaracTempo := ReadKey;
  674.                             if CaracTempo <> #13 then
  675.                             begin
  676.                                Bufferize(ord(CaracTempo));
  677.                                UpDate(EnCOurs);
  678.                             end;
  679.                             GotoXY(20,24);
  680.                             ClrEol;
  681.                          end;
  682.       end;
  683.    until (sortie);
  684.    Encode(No);
  685.    Edit := Car;
  686. end;
  687.  
  688. procedure EditeTable;
  689. var fin     : boolean;
  690.     Car     : char;
  691.     Car_Retour : char;
  692. begin
  693.    fin := false;
  694.    Encours := 32;
  695.    repeat
  696.       Bufferize(Encours);
  697.       Car_Retour := Edit(EnCours);
  698.       case car_Retour of
  699.          #13 : begin
  700.                   gotoXY(20,24);
  701.                   Write('Quitter ? ');
  702.                   Car := UpCase(readKey);
  703.                   GotoXY(1,24);
  704.                   ClrEol;
  705.                   if Car = 'O' then Fin := true;
  706.                end;
  707.          #81 : begin
  708.                   if EnCours = 180 then Encours := 32 else inc(EnCours);
  709.                end;
  710.          #73 : begin
  711.                   if EnCours = 32 then Encours := 180 else dec(EnCours);
  712.                end;
  713.          #27 : begin
  714.                   gotoXY(20,24);
  715.                   Write('Abandon des modifications ? ');
  716.                   Car := UpCase(readKey);
  717.                   GotoXY(1,24);
  718.                   ClrEol;
  719.                   if Car = 'O' then Halt(0);
  720.                end;
  721.       end;
  722.    until fin;
  723. end;
  724.  
  725. procedure SauveTable;
  726. var Fichier : Text;
  727.     i       : byte;
  728.     j       : byte;
  729. begin
  730.    Assign(Fichier, 'Mid.FON');
  731.    Rewrite(Fichier);
  732.    For i := 32 to 180 do
  733.    begin
  734.       for j := 0 to 18 do
  735.       begin
  736.          writeLn(Fichier, MidCar[i]^[j]);
  737.       end;
  738.       WriteLn(Fichier);
  739.    end;
  740.    Close(Fichier);
  741. end;
  742.  
  743. begin
  744.    DetectGraph(GrDriver, GrMode);
  745.    InitGraph(grDriver, grMode,'\turbo\tp\');
  746.    ErrCode := GraphResult;
  747.    if ErrCode <> grOk then
  748.    begin
  749.      Writeln('Graphics error:', GraphErrorMsg(ErrCode));
  750.      Halt(255);
  751.    end;
  752.    CloseGraph;
  753.  
  754.  
  755.    NormVideo;
  756.    ReserveMemoire;
  757.    ChargeTable;
  758.    EditeTable;
  759.    SauveTable;
  760. end.
  761.  
  762. {$define}
  763. {same remark as above}
  764. program GenMidCar;
  765.  
  766. {CopyRight Thierry De Leeuw 1994}
  767.  
  768. uses crt, dos, graph;
  769.  
  770. Type TBigCar = Array [0..36] of LongInt;
  771.      PBigCar = ^TBigCar;
  772.      TEtat = (Move, delete, trace);
  773.  
  774. var  BigCar : Array[32..180] of PBigCar;
  775.      Buffer   : Array[0..31,0..36] of Char;
  776.      grDriver : Integer;
  777.      grMode   : Integer;
  778.      ErrCode  : Integer;
  779.      EnCours  : Byte;
  780.      Etat     : TEtat;
  781.  
  782. Procedure ReserveMemoire;
  783. var i : byte;
  784. begin
  785.    For i := 32 to 180 do
  786.    begin
  787.       New(BigCar[i]);
  788.    end;
  789. end;
  790.  
  791. procedure ChargeTable;
  792. var Fichier : Text;
  793.     i       : byte;
  794.     j       : byte;
  795. begin
  796.    {$Ifndef First}
  797.    Assign(Fichier, 'Big.FON');
  798.    Reset(Fichier);
  799.    {$Endif}
  800.    For i := 32 to 180 do
  801.    begin
  802.       for j := 0 to 36 do
  803.       begin
  804.          {$IFDEF First}
  805.          BigCar[i]^[j] := 0;
  806.          {$Else}
  807.          readLn(Fichier, BigCar[i]^[j]);
  808.          {$Endif}
  809.       end;
  810.       {$Ifndef First}
  811.       Readln(Fichier);
  812.       {$Endif}
  813.    end;
  814.    {$Ifndef First}
  815.    Close(Fichier);
  816.    {$endif}
  817. end;
  818.  
  819. function Analyse(Valeur: byte) : String;
  820. var Tmp : String[19];
  821. begin
  822.    Tmp := ' ';
  823.    Analyse := Tmp
  824. end;
  825.  
  826. Procedure Update(No : Byte);
  827. var i : byte;
  828.     j : byte;
  829.  
  830. begin
  831.    ClrScr;
  832.    textMode(258);
  833.    LowVideo;
  834.    GotoXY(1,1);
  835.    if etat = move then write('Move')
  836.    else
  837.       if etat = delete then write('Delete')
  838.       else
  839.          if etat = trace then write('Trace');
  840.    GotoXY(22,1);
  841.    Write('Edition du caractère n° ',No:3,' - "',Chr(No),'".');
  842.    GotoXY(22,2);
  843.    Write('══════════════════════════════════');
  844.    gotoXY(2,4);
  845. Write('╔══════════════════════════════════════════════════════════════════╗');
  846.    gotoXY(2,5);
  847.    Write('║ ║');
  848.    gotoXY(2,6);
  849.    Write('║ ║');
  850.    gotoXY(2,7);
  851.    Write('║ ║');
  852.    gotoXY(2,8);
  853.    Write('║ ║');
  854.    gotoXY(2,9);
  855.    Write('║ ║');
  856.    gotoXY(2,10);
  857.    Write('║ ║');
  858.    gotoXY(2,11);
  859.    Write('║ ║');
  860.    gotoXY(2,12);
  861.    Write('║ ║');
  862.    gotoXY(2,13);
  863.    Write('║ ║');
  864.    gotoXY(2,14);
  865.    Write('║ ║');
  866.    gotoXY(2,15);
  867.    Write('║ ║');
  868.    gotoXY(2,16);
  869.    Write('║ ║');
  870.    gotoXY(2,17);
  871.    Write('║ ║');
  872.    gotoXY(2,18);
  873.    Write('║ ║');
  874.    gotoXY(2,19);
  875.    Write('║ ║');
  876.    gotoXY(2,20);
  877.    Write('║ ║');
  878.    gotoXY(2,21);
  879.    Write('║ ║');
  880.    gotoXY(2,22);
  881.    Write('║ ║');
  882.    gotoXY(2,23);
  883.    Write('║ ║');
  884.    gotoXY(2,24);
  885.    Write('║ ║');
  886.    gotoXY(2,25);
  887.    Write('║ ║');
  888.    gotoXY(2,26);
  889.    Write('║ ║');
  890.    gotoXY(2,27);
  891.    Write('║ ║');
  892.    gotoXY(2,28);
  893.    Write('║ ║');
  894.    gotoXY(2,29);
  895.    Write('║ ║');
  896.    gotoXY(2,30);
  897.    Write('║ ║');
  898.    gotoXY(2,31);
  899.    Write('║ ║');
  900.    gotoXY(2,32);
  901.    Write('║ ║');
  902.    gotoXY(2,33);
  903.    Write('║ ║');
  904.    gotoXY(2,34);
  905.    Write('║ ║');
  906.    gotoXY(2,35);
  907.    Write('║ ║');
  908.    gotoXY(2,36);
  909.    Write('║ ║');
  910.    gotoXY(2,37);
  911.    Write('║ ║');
  912.    gotoXY(2,38);
  913.    Write('║ ║');
  914.    gotoXY(2,39);
  915.    Write('║ ║');
  916.    gotoXY(2,40);
  917.    Write('║ ║');
  918.    gotoXY(2,41);
  919.    Write('║ ║');
  920.    gotoXY(2,42);
  921.    Write('║ ║');
  922.    gotoXY(2,43);
  923. Write('╚══════════════════════════════════════════════════════════════════╝');
  924.    For i := 0 to 36 do
  925.    begin
  926.       gotoXY(3,5+i);
  927.       For j := 0 to 31 do
  928.          Write(' ' + Buffer[j,i]);
  929.    end;
  930. end;
  931.  
  932. Procedure Bufferize(No : Byte);
  933. var i : byte;
  934. begin
  935.    for i := 0 to 36 do
  936.    begin
  937.       if BigCar[No]^[i] and 1 <> 0 then Buffer[0,i] := '*' else Buffer[0,i] :=
  938. '·';
  939.       if BigCar[No]^[i] and 2 <> 0 then Buffer[1,i] := '*' else Buffer[1,i] :=
  940. '·';
  941.       if BigCar[No]^[i] and 4 <> 0 then Buffer[2,i] := '*' else Buffer[2,i] :=
  942. '·';
  943.       if BigCar[No]^[i] and 8 <> 0 then Buffer[3,i] := '*' else Buffer[3,i] :=
  944. '·';
  945.       if BigCar[No]^[i] and $10 <> 0 then Buffer[4,i] := '*' else Buffer[4,i]
  946. := '·';
  947.       if BigCar[No]^[i] and $20 <> 0 then Buffer[5,i] := '*' else Buffer[5,i]
  948. := '·';
  949.       if BigCar[No]^[i] and $40 <> 0 then Buffer[6,i] := '*' else Buffer[6,i]
  950. := '·';
  951.       if BigCar[No]^[i] and $80 <> 0 then Buffer[7,i] := '*' else Buffer[7,i]
  952. := '·';
  953.       if BigCar[No]^[i] and $100 <> 0 then Buffer[8,i] := '*' else Buffer[8,i]
  954. := '·';
  955.       if BigCar[No]^[i] and $200 <> 0 then Buffer[9,i] := '*' else Buffer[9,i]
  956. := '·';
  957.       if BigCar[No]^[i] and $400 <> 0 then Buffer[10,i] := '*' else
  958. Buffer[10,i] := '·';
  959.       if BigCar[No]^[i] and $800 <> 0 then Buffer[11,i] := '*' else
  960. Buffer[11,i] := '·';
  961.       if BigCar[No]^[i] and $1000 <> 0 then Buffer[12,i] := '*' else
  962. Buffer[12,i] := '·';
  963.       if BigCar[No]^[i] and $2000 <> 0 then Buffer[13,i] := '*' else
  964. Buffer[13,i] := '·';
  965.       if BigCar[No]^[i] and $4000 <> 0 then Buffer[14,i] := '*' else
  966. Buffer[14,i] := '·';
  967.       if BigCar[No]^[i] and $8000 <> 0 then Buffer[15,i] := '*' else
  968. Buffer[15,i] := '·';
  969.       if BigCar[No]^[i] and $10000 <> 0 then Buffer[16,i] := '*' else
  970. Buffer[16,i] := '·';
  971.       if BigCar[No]^[i] and $20000 <> 0 then Buffer[17,i] := '*' else
  972. Buffer[17,i] := '·';
  973.       if BigCar[No]^[i] and $40000 <> 0 then Buffer[18,i] := '*' else
  974. Buffer[18,i] := '·';
  975.       if BigCar[No]^[i] and $80000 <> 0 then Buffer[19,i] := '*' else
  976. Buffer[19,i] := '·';
  977.       if BigCar[No]^[i] and $100000 <> 0 then Buffer[20,i] := '*' else
  978. Buffer[20,i] := '·';
  979.       if BigCar[No]^[i] and $200000 <> 0 then Buffer[21,i] := '*' else
  980. Buffer[21,i] := '·';
  981.       if BigCar[No]^[i] and $400000 <> 0 then Buffer[22,i] := '*' else
  982. Buffer[22,i] := '·';
  983.       if BigCar[No]^[i] and $800000 <> 0 then Buffer[23,i] := '*' else
  984. Buffer[23,i] := '·';
  985.       if BigCar[No]^[i] and $1000000 <> 0 then Buffer[24,i] := '*' else
  986. Buffer[24,i] := '·';
  987.       if BigCar[No]^[i] and $2000000 <> 0 then Buffer[25,i] := '*' else
  988. Buffer[25,i] := '·';
  989.       if BigCar[No]^[i] and $4000000 <> 0 then Buffer[26,i] := '*' else
  990. Buffer[26,i] := '·';
  991.       if BigCar[No]^[i] and $8000000 <> 0 then Buffer[27,i] := '*' else
  992. Buffer[27,i] := '·';
  993.       if BigCar[No]^[i] and $10000000 <> 0 then Buffer[28,i] := '*' else
  994. Buffer[28,i] := '·';
  995.       if BigCar[No]^[i] and $20000000 <> 0 then Buffer[29,i] := '*' else
  996. Buffer[29,i] := '·';
  997.       if BigCar[No]^[i] and $40000000 <> 0 then Buffer[30,i] := '*' else
  998. Buffer[30,i] := '·';
  999.       if BigCar[No]^[i] and $80000000 <> 0 then Buffer[31,i] := '*' else
  1000. Buffer[31,i] := '·';
  1001.  
  1002.    end;
  1003. end;
  1004.  
  1005. procedure Encode(No : Byte);
  1006. var i,j : byte;
  1007. begin
  1008.    for i := 0 to 36 do
  1009.    begin
  1010.       BigCar[No]^[i] := 0;
  1011.       if Buffer[0,i] = '*' then BigCar[No]^[i] := 1;
  1012.       if Buffer[1,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $2;
  1013.       if Buffer[2,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $4;
  1014.       if Buffer[3,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $8;
  1015.       if Buffer[4,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $10;
  1016.       if Buffer[5,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $20;
  1017.       if Buffer[6,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $40;
  1018.       if Buffer[7,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $80;
  1019.       if Buffer[8,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $100;
  1020.       if Buffer[9,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $200;
  1021.       if Buffer[10,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $400;
  1022.       if Buffer[11,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $800;
  1023.       if Buffer[12,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $1000;
  1024.       if Buffer[13,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $2000;
  1025.       if Buffer[14,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $4000;
  1026.       if Buffer[15,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $8000;
  1027.       if Buffer[16,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $10000;
  1028.       if Buffer[17,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $20000;
  1029.       if Buffer[18,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $40000;
  1030.       if Buffer[19,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $80000;
  1031.       if Buffer[20,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $100000;
  1032.       if Buffer[21,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $200000;
  1033.       if Buffer[22,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $400000;
  1034.       if Buffer[23,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $800000;
  1035.       if Buffer[24,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $1000000;
  1036.       if Buffer[25,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $2000000;
  1037.       if Buffer[26,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $4000000;
  1038.       if Buffer[27,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $8000000;
  1039.       if Buffer[28,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $10000000;
  1040.       if Buffer[29,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $20000000;
  1041.       if Buffer[30,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $40000000;
  1042.       if Buffer[31,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $80000000;
  1043.    end;
  1044. end;
  1045.  
  1046. procedure Preview;
  1047. var i, j : byte;
  1048. begin
  1049.    initGraph(grDriver,GrMode,'\turbo\tp\');
  1050.    for i := 0 to 36 do
  1051.    begin
  1052.       for j := 0 to 31 do
  1053.       begin
  1054.          if Buffer[j,i] = '*' then putpixel(j+GetMaxX div 2 ,i+GetMaxY div
  1055. 2,15);
  1056.       end;
  1057.    end;
  1058.    readkey;
  1059.    closeGraph;
  1060. end;
  1061.  
  1062. procedure PreviewAll;
  1063. var i, j, k : byte;
  1064. begin
  1065.    initGraph(grDriver,GrMode,'\turbo\tp\');
  1066.    for k := 32 to 47 do
  1067.    begin
  1068.       Bufferize(k);
  1069.       for i := 0 to 36 do
  1070.       begin
  1071.          for j := 0 to 31 do
  1072.          begin
  1073.             if Buffer[j,i] = '*' then putpixel(j+(k-32) * 36 ,i+20,15);
  1074.          end;
  1075.       end;
  1076.    end;
  1077.    for k := 48 to 96 do
  1078.    begin
  1079.       Bufferize(k);
  1080.       for i := 0 to 36 do
  1081.       begin
  1082.          for j := 0 to 31 do
  1083.          begin
  1084.             if Buffer[j,i] = '*' then putpixel(j+(k-48) * 36 ,i+60,15);
  1085.          end;
  1086.       end;
  1087.    end;
  1088.    for k :=  97 to 127 do
  1089.    begin
  1090.       Bufferize(k);
  1091.       for i := 0 to 36 do
  1092.       begin
  1093.          for j := 0 to 31 do
  1094.          begin
  1095.             if Buffer[j,i] = '*' then putpixel(j+(k-97) * 36 ,i+100,15);
  1096.          end;
  1097.       end;
  1098.    end;
  1099.    for k :=  128 to 155 do
  1100.    begin
  1101.       Bufferize(k);
  1102.       for i := 0 to 36 do
  1103.       begin
  1104.          for j := 0 to 31 do
  1105.          begin
  1106.             if Buffer[j,i] = '*' then putpixel(j+(k-128) * 36 ,i+140,15);
  1107.          end;
  1108.       end;
  1109.    end;
  1110.    for k :=  156 to 180 do
  1111.    begin
  1112.       Bufferize(k);
  1113.       for i := 0 to 36 do
  1114.       begin
  1115.          for j := 0 to 31 do
  1116.          begin
  1117.             if Buffer[j,i] = '*' then putpixel(j+(k-156) * 36 ,i+GetMaxY div
  1118. 2+70,15);
  1119.          end;
  1120.       end;
  1121.    end;
  1122.    readkey;
  1123.    closeGraph;
  1124. end;
  1125.  
  1126. function Edit(No : byte) : Char;
  1127. var x, y : byte;
  1128.     car  : Char;
  1129.     Sortie : Boolean;
  1130.     Go     : byte;
  1131.     CaracTempo :  char;
  1132. begin
  1133.    UpDate(No);
  1134.    x := 0;
  1135.    y := 0;
  1136.    Sortie := false;
  1137.    Etat := Move;
  1138.  
  1139.    repeat
  1140.       GotoXY(1,1);
  1141.       Write('          ');
  1142.       gotoxy(1,1);
  1143.       if etat = move then write('Move')
  1144.       else
  1145.          if etat = delete then write('Delete')
  1146.          else
  1147.             if etat = trace then write('Trace');
  1148.       GotoXY(60,1);
  1149.       write('(',x:2,' , ',y:2,')');
  1150.       GotoXY(4 + 2*x,5+y);
  1151.       HighVideo;
  1152.       Write(Buffer[x,y]);
  1153.       GotoXY(4 + 2*x,5+y);
  1154.       repeat
  1155.       until keypressed;
  1156.       car := ReadKey;
  1157.       GotoXY(4 + 2*x,5+y);
  1158.       LowVideo;
  1159.       Write(Buffer[x,y]);
  1160.       if (car = 'q') or (car = 'Q') then car := #13;
  1161.       if car = #0 then car := ReadKey;
  1162.       case car of
  1163.          '2',chr(80)   : begin
  1164.                             if y = 36 then y := 0 else inc(y);
  1165.                             if etat = trace then buffer[x,y] := '*'
  1166.                             else if etat = delete then buffer[x,y] := '·';
  1167.                          end;
  1168.          '8',chr(72)   : begin
  1169.                             if y = 0 then y := 36 else dec(y);
  1170.                             if etat = trace then buffer[x,y] := '*'
  1171.                             else if etat = delete then buffer[x,y] := '·';
  1172.                          end;
  1173.          '4',chr(75)   : begin
  1174.                             if x = 0 then x := 31 else dec(x);
  1175.                             if etat = trace then buffer[x,y] := '*'
  1176.                             else if etat = delete then buffer[x,y] := '·';
  1177.                          end;
  1178.          '6',chr(77)   : Begin
  1179.                             if x = 31 then x := 0 else inc(x);
  1180.                             if etat = trace then buffer[x,y] := '*'
  1181.                             else if etat = delete then buffer[x,y] := '·';
  1182.                          end;
  1183.          '1',chr(80)   : begin
  1184.                             if y = 36 then y := 0 else inc(y);
  1185.                             if x = 0 then x := 31 else dec(x);
  1186.                             if etat = trace then buffer[x,y] := '*'
  1187.                             else if etat = delete then buffer[x,y] := '·';
  1188.                          end;
  1189.          '7',chr(72)   : begin
  1190.                             if y = 0 then y := 36 else dec(y);
  1191.                             if x = 0 then x := 31 else dec(x);
  1192.                             if etat = trace then buffer[x,y] := '*'
  1193.                             else if etat = delete then buffer[x,y] := '·';
  1194.                          end;
  1195.          '9',chr(75)   : begin
  1196.                             if x = 31 then x := 0 else inc(x);
  1197.                             if y = 0 then y := 36 else dec(y);
  1198.                             if etat = trace then buffer[x,y] := '*'
  1199.                             else if etat = delete then buffer[x,y] := '·';
  1200.                          end;
  1201.          '3',chr(77)   : Begin
  1202.                             if x = 31 then x := 0 else inc(x);
  1203.                             if y = 36 then x := 0 else inc(y);
  1204.                             if etat = trace then buffer[x,y] := '*'
  1205.                             else if etat = delete then buffer[x,y] := '·';
  1206.                          end;
  1207.          ' '           : if etat <> trace then etat := succ(etat) else etat :=
  1208. move;
  1209.          #13, #81, #73 : Sortie := true;
  1210.          #27           : Sortie := True;
  1211.          'G','g'       : begin
  1212.                             GotoXY(20,49);
  1213.                             Write('Aller à quel code ascii ? ');
  1214.                             Read(Go);
  1215.                             if (Go >= 32) and (go <= 180) then
  1216.                             begin
  1217.                                Encode(No);
  1218.                                EnCours := Go -1;
  1219.                                Car := #81;
  1220.                                Sortie := true;
  1221.                             end;
  1222.                             GotoXY(1,49);
  1223.                             ClrEol;
  1224.                          end;
  1225.  
  1226.          'v', 'V'      : begin
  1227.                            Preview;
  1228.                            update(No);
  1229.                          end;
  1230.          'a', 'A'      : begin
  1231.                             Encode(No);
  1232.                             PreviewAll;
  1233.                             Bufferize(No);
  1234.                             Update(No);
  1235.                          end;
  1236.          'c', 'C'      : begin
  1237.                             gotoXY(20,49);
  1238.                             Write('Copier quel caractère ? ');
  1239.                             CaracTempo := ReadKey;
  1240.                             if CaracTempo <> #13 then
  1241.                             begin
  1242.                                Bufferize(ord(CaracTempo));
  1243.                                UpDate(EnCOurs);
  1244.                             end;
  1245.                             GotoXY(20,49);
  1246.                             ClrEol;
  1247.                          end;
  1248.       end;
  1249.    until (sortie);
  1250.    Encode(No);
  1251.    Edit := Car;
  1252. end;
  1253.  
  1254. procedure EditeTable;
  1255. var fin     : boolean;
  1256.     Car     : char;
  1257.     Car_Retour : char;
  1258. begin
  1259.    fin := false;
  1260.    Encours := 32;
  1261.    repeat
  1262.       Bufferize(Encours);
  1263.       Car_Retour := Edit(EnCours);
  1264.       case car_Retour of
  1265.          #13 : begin
  1266.                   gotoXY(20,49);
  1267.                   Write('Quitter ? ');
  1268.                   Car := UpCase(readKey);
  1269.                   GotoXY(1,49);
  1270.                   ClrEol;
  1271.                   if Car = 'O' then Fin := true;
  1272.                end;
  1273.          #81 : begin
  1274.                   if EnCours = 180 then Encours := 32 else inc(EnCours);
  1275.                   etat := move;
  1276.                end;
  1277.          #73 : begin
  1278.                   if EnCours = 32 then Encours := 180 else dec(EnCours);
  1279.                   etat := move;
  1280.                end;
  1281.          #27 : begin
  1282.                   gotoXY(20,49);
  1283.                   Write('Abandon des modifications ? ');
  1284.                   Car := UpCase(readKey);
  1285.                   GotoXY(1,49);
  1286.                   ClrEol;
  1287.                   if Car = 'O' then Halt(0);
  1288.                end;
  1289.       end;
  1290.    until fin;
  1291. end;
  1292.  
  1293. procedure SauveTable;
  1294. var Fichier : Text;
  1295.     i       : byte;
  1296.     j       : byte;
  1297. begin
  1298.    Assign(Fichier, 'Big.FON');
  1299.    Rewrite(Fichier);
  1300.    For i := 32 to 180 do
  1301.    begin
  1302.       for j := 0 to 36 do
  1303.       begin
  1304.          writeLn(Fichier, BigCar[i]^[j]);
  1305.       end;
  1306.       WriteLn(Fichier);
  1307.    end;
  1308.    Close(Fichier);
  1309. end;
  1310.  
  1311. begin
  1312.    DetectGraph(GrDriver, GrMode);
  1313.    InitGraph(grDriver, grMode,'\turbo\tp\');
  1314.    ErrCode := GraphResult;
  1315.    if ErrCode <> grOk then
  1316.    begin
  1317.      Writeln('Graphics error:', GraphErrorMsg(ErrCode));
  1318.      Halt(255);
  1319.    end;
  1320.    CloseGraph;
  1321.  
  1322.  
  1323.    NormVideo;
  1324.    ReserveMemoire;
  1325.    ChargeTable;
  1326.    EditeTable;
  1327.    SauveTable;
  1328. end.
  1329.  
  1330. {
  1331. You'll find here the fonts I had already done. They are not complete. (use A
  1332. to see all the characters) You must use XX3402 that you'll find on the Swag.
  1333. If you make others fonts, would you please send them to me ?
  1334. }
  1335.  
  1336. { cut this out as save as FON.XX.  Use XX3402 :   XX3402 d FON.XX to
  1337.   create FON.ZIP containing the FONT files need here }
  1338.  
  1339. *XX3402-004554-160794--72--90-49467---------FON.ZIP--1-OF--1
  1340. I2g1--E++++6+1lIWFn1MZsTikA++8QI+++7++++Iop-H2kiFYxCXJVhggAU0DnTaRv3449h
  1341. yIzq+c6iWiaP0Ool-70D3NDSfxrpTaJujocOlDRAA5mzXdHptmmlaDi5Z+tylkr6i6vvvSia
  1342. md8HXZCvtn2z3xPDHKRh2okwHDTQhs6Y2trjmNAOAQAr8lDJFaRi9mlKqsDe9tvWFvTcKw1m
  1343. a4FSF-k3XAwoJeTeCZCbH5v0aBN91NgaBHPSxRA3ARGLS35gZaxd5V2fvjgmZg8K3zAn9y4X
  1344. 2lRMmJsFfyfMuAVUXIYet1lwc2b6EzfzeAlw7k8DX6gX0MYYAAKGH7ilpNJ3lAlKno5eJhRp
  1345. 5D46Km81627lm1m1rTKIa3l99ao9iPEkjzjIURmqxsMkmMYcX8C8Sebqj75bIdS-RvJQVqBc
  1346. r-UHVaMS-t4YI-AnTz788AFGVVdqh739nt+XG3zG7IS7oAqTpshfjV+PU7nn1eWoHgIbX+aK
  1347. STqTZR3miIKrueyhyij4M-snAbkAu-Uit4RS3fsRyaQ8wRP7FYBRBZ-vndj+66Lce0MLO6sE
  1348. 63fIIy0B8CrZa9j3xvCjyutOlbXaEEKFoHrvcAdvJUeHS9F4Znld6-HVX2F-CAv++8HHvRjV
  1349. hNZarRQZ4vfczzKi-PWVfupVCACKlbkFD60I4a8AxFFAD5wKqu0qIUlE5+j9yHFnQbRsVi+C
  1350. x1QJdWvHsr6y4DrGdSkEtgn9iV-XiW6KHGe9oeHeeLlEKPi6Fi6PHOtHsJ2tSyR4FEUmZ0tf
  1351. Ell5fNBnhIg8VCnWQlKD8lPVCYJKcoq9U5ajQjpBKj-Wld8Jcl6orMs1cKFpe1C+pq9q+gxV
  1352. uLVcjUoIyQuFbxecthQbY10GnfFvXR03wdHnsYdUZMS0UwwDxTcx4Dh5usHPJFIE8a1gt42D
  1353. 8r1+a+iytmEUrkB+oLxEf5dhANDdgz9P6y6KvqdYRvGqx7j3BcrzWRa03JWntOazAOzIzzGY
  1354. u278HpnJRMrOAffaWWi4gOOaQE8HBWNVxOn55MIauLj0DBfUrmyK8MQW3h0oHrq6utt7THLl
  1355. xBDFJM+dOVpRr+7BoL21tI-CBrE7RpvNPB-YppDpLA8YOZYqhRpm6j--MkxJA+mHAWScBD1-
  1356. jenfvle7TFakv6Aa4zqDfFVsv41EizHCN8aiqgg0ptXcKXCCeOTeIT0IWejm6fDPANOD8CTV
  1357. DRQXSIVPeq3gwJ6RqNoC3vMY-rHxyX+KHHpEoKQqr5IZLJHW7vybdVOT44RD9TOrSCxtw9wB
  1358. YETwfIUFujjJD+gbUZBdEChACGCiDp-9+kEI++++0++JUMoQbzQ8qa+5++-FC+++-k+++2p7
  1359. F0t4HovJKyhmvGc6zhyNjcire5by7ng-j60L74NZRQyNOP-B6WX07q0eTbySzTnyu1qurlyb
  1360. T83F-mwdTofjlxobEbnkptsJSzbskxbRpANM0nmAUPSpBaj1hhec8yernKuZySkhcYQ92n78
  1361. cqvURyq0Wn+R5sv4vWcF-nAmmc3mh3Ts6f+kPjSW0OMk6Mv25EIVkFZP2o09PhTFEnSj3SfE
  1362. 59qx-VtK6OQBh-dwH7opu-dvFZExXWEsEspqp4VwNYBGvUTaJ+o1lv0V3XOzm+F5vPJnSJdq
  1363. kwbUt5G+dwUSGFJNtG8V3uYHAG-al7W256c-RGPxu8EgB2dwXgH-kofe+rkDHFxukXBYZRSg
  1364. 9C5F9NNJ1Zs-7lJJKKgHT4rc5XqbRpB5sZ8t6a29pXldWDMKC8Paz3qq3jTLfGe6b+FKLNhs
  1365. lcEAbiWdFOkOcg+b6N0kls+aiM4RyUpOUw43ZKBWO71+F8DpYTpuI9HTUP3rk0DFPMCb-fVv
  1366. Mz3rJTcG5sM-KJOmtdpQ3zFu94INyGQo2ikXnR9G+1kAoWcQ8UuDR9OYCSCuVOM7gSr07szr
  1367. OWVWXqInsGsg8TJ3TqKPHuCyaF8H8UZZT4COuyfXjEqvRX6MFnh8cwwFrInKD+SA9AMd45NY
  1368. IyT026hI9-i9BZOPKkrTxYRHmfO+WuvOrOSpW0aVmQUdQTHXMbd8vxltQuv+dx8S9JQ9H9TE
  1369. eoD-FFPxDYnyg6W-3C0Nx6XqJxdNaIAadV7n9u5yt32OOhqW9sNl0wPbWpyw+8QVanBBhHhb
  1370. 2vmFWC82GbKBpHUlNmWY36opV2Q64bhA0WaLhy0fFyCNtb4d8GV5Z9D7YjSdslQqq3l1V3mW
  1371. GtUdHZ3ccz2V0gK0M8qsaeX6DWrywSgIspMawvGNHoWeDlf2FHtwr16GPON3PogCvr5bZyGO
  1372. oVcmj-Dpuwp4pYmg1mBttBUuzqoZftfkaI5nfSZw2vivisbpcC0M4fu-9ZAK9St1tF2gMoBV
  1373. 7gIRSUAcW9+yawcYob9hdYEbFbJQIhCcuwFeFhQBaoq9Yuc3aoDUQqWXqVdAWkvpLI16wffL
  1374. NnFLFs8GGO4KhA4ci2ULXIKcpnNWcaVhWcQ6nmbv5iDb1B+yVdkNmd4vQmkS-Xpl5FXi-pIL
  1375. 33Ab5YUpgQmBST+Ns3eaaU0gVAlfKbdrUR03T7qpPOCVohlPZkmc0F9r64cOuyElb9tbOizk
  1376. dyW36Va8OX1+YRKZRyEZLmOIGNWH2QWm4Ce4qAac8vYNcBqTcN0sZn-trJGOzREEueqZ1FR+
  1377. vnRomhEwr4V5F18ayFmDXXh9yMFkNCCqE1JMGDCUKdQXvUoee2VSb27ZaidcK3i9kfpiZpFL
  1378. SrG3wItB5sxV08Y0APo3FQg6Isi6wJU2qvbz82OaM5stB2kFgolBFvB97OTHM3UCTEGIOd7v
  1379. rZ56yHHCZ0JnwLYAnNIVtpCDWXfacYFZ+2ZrHpSBCzARThKbwz4Ou+DHlxbeWWltcaCi8lfk
  1380. qyMYaatSPFKVph7jY25ofqF-fUVdvexEZ3GCF8fBpWjUgEISAS1iH-3n7jUbDg-LM3DBhDRV
  1381. SEWnHb11DfLqsDXiZ4DrlSP8btXtjKIdRnpq+S4ewts8GQ-XzOn7vVBG+A0jR6MuMxzLZXbB
  1382. JQ9UtkJMABAdEBQHJYdfNwbAo75YODqkw759T5s+szVG5m5bxVsatgjeic4IIsvtS-z5kKEP
  1383. JcJn41sDTTg+y1lsTn7sYM7jm1HgR4kDhwtLYm7IAZzOcOkVnFeJEo7WVfTd3NozLx0bTjBI
  1384. txp4hPDu5JfFI7csscJSBMH34G+WIjp3RIT0H2hdMyoRP3O5Gjg1bOily9abDQwYvBLMSIEU
  1385. SKgClldwceF3pSm3Lm8GErNlcqr1s8Zy0CIISCbbs8WXqksVpgC56zzcfxwDuietqVJRZ01L
  1386. bESCzS8dfpn1J7CJjVvXhiQgLwtgt3vvHK51NCwvcUVVAOQaaWJyAo3QmRqcKdWhb4RjPSZX
  1387. NV1TG8l49jGWY3aqzzswq+QMvyExkq97dolZcSU3bWYucb5yoIbhqBIK1cijNPTG8jX8ngod
  1388. tCE2wjeQuBbDdpr5PjupJ4nJptw94vfxRoGBRTWB84+seKw6SWqmiNw3XCGxQNcsCQptNrdf
  1389. loSeeMvNyhrUSg4pGkcy+s9zJxQqLjZqi1cKxwaiCKPt5MmOmbcRCfE7W2ts64pX4r+lF5Uc
  1390. KQf0+nx35tAbRqgzS1Xtoi5V7ktDPLOO5Z0pMMoDkzzF+OWRT1DMO9FKWiVoUoMmYTnd2SS2
  1391. vGR5Xe9udG9zG+xfDCXny7Ju85o0famA0jyr-SgqJDZFuKFU3ddRG5+FDlDN6+9Mw-oLe1N3
  1392. yk2KJ7n4TtbEGWvdxLwReSNXq4TzvREdLlgg2uJecOOeZpTZJACLqvZO8AwW7atlrbgWfERt
  1393. yhXZI0-coOBPzwKhMqn-iTrrNvQS10A4Q7szj+TTsSVUXw5t06tVcc7zZjffarxEm3nuSi07
  1394. UDw+I2g1--E++++6+AloXVlDpuzgVkI++DBH+++5++++EYZ59YNDHipNuqsXCkXyLubjkgI4
  1395. yzaTv-XkX4SmiPFdYxoX6OK-n6IDA4-AsTDXbNzD1mFePL-I4tHqyJ47eA0W02JfdKSNGr4r
  1396. u+NzWqtevdzGoSFzLSpPW3DEkGKAdLM0SAFFFJ4K2nSchh-UtlerXaEuMmxJLfCChGa-Eba4
  1397. Ep1KUcrUOzlDgBv9jRCmnkyWnWe9WW6otQ2V3o6J4MyFhA8pY9r9oVFO5kwIuPqXDp0+KeDa
  1398. 2GNBd68GmlGIfpD5PdsuUKocUQqRBalhdUMATKefwVfKh+yqksvKdNrgDrXZs8jZk2jLPjGE
  1399. +ppUmd48t5uIKgZnL9d8EElB43gh7P7KU1pCe1M4x2KXXiCpaSZ8JbLEe3Uium1gBngHSgPr
  1400. 6QESuYB0qGeHeH9SxURauF6gRdh-DSeepkgJiwLB8oOr4khTlawdrQCbYcUf5SloZ93FRc8Z
  1401. Bhw0iqyG9ifBSrSLokNnWvfPRW8pqb7DkeEK7mVgQTc8tIFJmTCagk0O+lT5J030SEL+jisv
  1402. gurvFjw6pFY5SnlUYRNyXpv8jwGzp0x0y7cZ-mhrmuztNLbBZb3Qw-Hq9zP2bj2Q6Hv71Dx7
  1403. jaj2fx25Wr4VtQa0g0cgL-Ov+usMw6+mBk08AZZpL+9PGvd6wQ958CWZVp4VxB0WPko3cfeE
  1404. Udrx8M7SAHOwIcdRWRcO3TQFivyoWxY3vp+9TKaoh3mO9qiKVRzpnIMDeTegW4zHq6T8ZxVr
  1405. uHHdKufsfQG7PKvFQsJy+aRhy+zN7wlseMiSKuRdY0K2hmOAheZtOo7lVf5KF06F8oeRtkUO
  1406. H7kTpcPyRpcHHzfE9nGnnDTwzjlcpzrTS+-saFGp5hHfEeoZBbhfRQ0XOaVA09vJaVCuq+tp
  1407. NeKnOs5IJL1ePrpWl0KdxWfFKIUPTu4W1+jN1s6o-044-+4RdNpe9sJw0lWghMjHtlpVQrxh
  1408. d-Gg+BCwKaNNhhNFcYwlRWu9gP50nW9uAS+q0x4RBXJ5mB39mrCvAzTmT5Pqjhs2JdZhNI08
  1409. xosoffiCUqbF8ECd-kDq9bvOkBuUcCSuqW5N-PPMwHT7zmC4iFO75Sg8RzMQEFQrp1mfRXsm
  1410. LoTQK9A1PPO14Xo+ZdaRpVGVrnpnZmrHTKuZAnAkc1Tu3hbC1HqeklNgsa40I8Gu023D1zhZ
  1411. hcjjhx4WFAvSzptFRdyvW1C9G1EjqFCFZLtIWomAwlhgKE0+gdKliVqqe3Bddy9q91jY2zgq
  1412. 6EcxwbSclH5RKRmuSrXZ3z+jqMBRRFohkkT9AwhRmsL9fFTiXV6zaAOnLDssoKRzqtJpvVFx
  1413. VcIx2cl4+FlMRRhBcanvOA51vWvrpemLMMSXbborFknh8qntnhT-nAjNXVz1EutsUow+bLo+
  1414. QxXWLw1KTQ+VJLQoLRpyH5fL2CVeE3s25lRgNNyhMDRdZ6YHobpwledaRCRSapO9kkOJiQKa
  1415. BVtiseAavLmcHrOZalsyt6Vuiby3Pac01XrrMKGonSow6E-2a5ogyptyuT1ElKT5fU5RTQvr
  1416. VV-ZRI-hHzdtezRDY4gC+PUmgHkgzHN1N7jRkPjNUnc57KzcypsZZrSi8vbQywTVtBzmz+PQ
  1417. HXLUlVHvdTKohDpIJdTlTivxWPjj12ArydDDBqLzCsdRbEGTFw0TVktonarbGTZuCzqSor5k
  1418. qtEk5hgaWBizJuTA1KD1L8SJHOpRoQAoRfTbQ5XMvJuyi9OUlwzOsyxnxtTlRuEQ0vyTB8oB
  1419. g7mDErKQHZvcrFQDGIePBdZlXxPZNTxvGQ+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2
  1420. HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+T+js5I2g-
  1421. +VE+3+++++U+D3G75ABWLVyv+k++dlE+++Y++++++++++E+U+++++++++3BBEIlA9YNDHZ-9
  1422. +E6I+-E++++6+-K-XFmTxkfOM+Q++32s+++5++++++++++2+6++++C61++-BGIEiFYxCI2g-
  1423. +VE+3+++++U+n5GC52zLfym5-E++wpA+++Q++++++++++E+U++++Nkg++277Fmt4HotEGkI4
  1424. ++++++A++k0V++++2l2+++++
  1425. ***** END OF BLOCK 1 *****
  1426.